perm filename SAME.FR[F76,JMC] blob sn#254278 filedate 1976-12-10 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00004 ENDMK
C⊗;


;;;IF SOMEONE ELSE IS POINTING AT THE ARGUMENTS TO SAMEFRINGE THEN
;;;NO CELLS WILL BE GARBAGE COLLECTED. THE FOLLOWING ADAPTATION OF YOUR PROGRAM     
;;;USES NO NEW CELLS AT ALL. IT WORKS EVEN IF THE ARGUMENTS HAVE SHARED STRUCTURES.

(DEFUN SAMEFRINGE (X Y) (SAME X Y NIL NIL)) 

(DEFUN SAME (X Y U V) 
       (COND ((EQ X Y)
	      (COND ((NULL U)
		     T
		     ;;;(NULL U) ∨ (NULL V) ↔ (NULL U) ∧ (NULL V)
		     )
		    (T (SAME (CDR U)
			     (CDR V)
			     (PROGN 
				    ;;;X AND Y ARE EQ SO WE HAVE A VARIABLE TO SPARE
				    (SETQ Y (CAR U))
				    ;;;REBUILD
				    (RPLACA U X)
				    Y)
			     (PROGN (SETQ Y (CAR V))
				    (RPLACA V X)
				    Y)))))
	     ((NOT (OR (ATOM X) (ATOM Y)))
	      (SAME (CAR X) (CAR Y) (RPLACA X U) (RPLACA Y V))))) 

;;;LOOKS PRETTY NICE WITHOUT THE COMMENTS
(DEFUN SAME (X Y U V) 
       (COND ((EQ X Y)
	      (COND ((NULL U) T)
		    (T (SAME (CDR U)
			     (CDR V)
			     (PROGN 
				    (SETQ Y (CAR U))
				    (RPLACA U X)
				    Y)
			     (PROGN (SETQ Y (CAR V))
				    (RPLACA V X)
				    Y)))))
	     ((NOT (OR (ATOM X) (ATOM Y)))
	      (SAME (CAR X) (CAR Y) (RPLACA X U) (RPLACA Y V)))))